Access VBAでリストボックスの内容を動的に変えて印刷する

Access VBAでリストボックスの内容を動的に変えて印刷する

Clock Icon2012.07.23

この記事は公開されてから1年以上経過しています。情報が古い可能性がありますので、ご注意ください。

Accessでレポートを印刷するって今までやったことなかったので、調べながらですがなんとかできたので、備忘録としてまとめておこうと思います。

ただ、このやり方が正しいがどうかは分かりませんが、やりたいことはできたと言うレベルです。

やりたいことは簡単で 『検索条件を指定して条件に合致したレコードのみを印刷したい』ただそれだけです。。。

作業着手前の状態として

  1. リストボックスの一覧に表示させるクエリが既に用意されている。(クエリ名:売上一覧クエリ)
  2. 一覧画面を初期表示した際には”売上一覧クエリ”で合致するすべてのレコードがリストボックスに表示される。
  3. 検索条件として、顧客名、開始日付、終了日付及び完了/未完了の条件が指定できる。

ということで、検索条件を指定して実行すると、その検索条件にあったレコードがリストボックスに表示されることまでは動作確認済み。

まずは一覧画面でリストボックスに表示されているものを印刷するにはどうすればいいのか?そもそもここからスタートでしたが、調べながら進めてみました。

STEP1 レポートウィザードをクリックし、テーブル/クエリのプルダウンで『クエリ:売上一覧クエリ』を選択してレポートを定義します。 必要に応じて、デザインビューやレイアウトビューで幅なフォントサイズなどを定義します。

STEP2 次にフォーム画面(売上一覧画面)に印刷のボタンを配置し、そのボタンがクリックされた場合のプロシージャに印刷するためのVBAコードを記述する。

印刷は DoCmd.OpenReport を利用して印刷するようなので

DoCmd.OpenReport "売上一覧クエリ"

とすれば全レコードが印刷される。

当然これだけであれば何の問題もないのですが、検索条件に合致したレコードだけを印刷したいので動的に検索条件が変わる。これがポイントです。

【書式】DoCmd.OpenReport reportname[, view][, filtername][, wherecondition]

と書いてあるのですが、いまいちピンと来ない><

DoCmd.OpenReport "売上一覧クエリ"

だと毎回クリックのたびに印刷されるのもどうかと思いますので、とりあえずプレビューにできることが分かりましたので、そのオプションを指定します。

DoCmd.OpenReport "売上一覧クエリ", acViewPreview

で、whereconditionに条件を指定すればいけるようなことが書いてあったので、早速ハードコーディングで値を入れて動作を確認してみました。 ※指定する際にはWHEREは含めない

DoCmd.OpenReport "売上一覧クエリ", acViewPreview, ,"CompanyName='サンプル会社'"

これで検索条件に指定した会社名でプレビューができました。

次にあいまい検索に条件を変えてみます。

DoCmd.OpenReport "売上一覧クエリ", acViewPreview, ,"CompanyName like 'サンプル*'"

これで検索条件に前方一致した会社名でプレビューができました。

ということで、動的にSQLを組み立ててwhereconditionに指定すればそのまま意図したレコードをプレビューすることができそうです。

で、売上一覧フォーム画面で指定された検索条件の値をどうやって引き継ぐか?ですが面倒なので、public変数にもつことにしました。(強引ですが動かすことを最優先で) Generalの部分に以下のPublic変数を宣言します。

public strClaimSt As String
public strClaimEd As String
public strCompany As String
public strInvoice As String

で、検索条件をセットしているコード部分にこそっと以下の行を追加します。

strCompany = Me.txtCompanyName

あとは日付の開始と終了と会社名とフラグの検索条件をセットしているところに同じ様にこそっと追加しました。以下はそのコードサンプルです。

Private Sub cmdFilter_Click()

    Dim strFilter As String
    Dim strFilterterm As String
    
    strClaimSt = ""
    strClaimEd = ""
    strCompany = ""
    strInvoice = ""

    '会社名セット
    If Not IsNull(Me.txtCompanyName) Then
        strFilter = strFilter & " AND CompanyName Like '*" & Me.txtCompanyName & "*'"
        strCompany = Me.txtCompanyName '←追加したコード
    End If
    
    '期間開始日セット
    If Not IsNull(Me.txtClaimday_Start) Then
        strFilter = strFilter & " AND ClaimDate >= #" & Nz(Me.txtClaimday_Start) & "#"
        strClaimSt = Me.txtClaimday_Start '←追加したコード
    End If
    
    '期間終了日セット
    If Not IsNull(Me.txtClaimday_End) Then
        strFilter = strFilter & " AND ClaimDate <= #" & Nz(Me.txtClaimday_End) & "#"
        strClaimEd = Me.txtClaimday_End '←追加したコード
    End If
    
    '完了フラグセット
    strInvoice = vbNullString
    If Not IsNull(grpClaim) Then
        If grpClaim = 1 Then        '完了の場合
            strFilter = strFilter & " AND InvoiceCopy = True "
            strInvoice = " InvoiceCopy = True " '←追加したコード
        ElseIf grpClaim = 2 Then    '未完了の場合
            strFilter = strFilter & " AND InvoiceCopy Is Null "
            strInvoice = " InvoiceCopy Is Null " '←追加したコード
        End If
    End If

    '条件で抽出する
    strFilterterm = Mid(strFilter, 6)
    If strFilterterm <> "" Then
        Me.lstSales.RowSource = "SELECT * FROM [売上一覧クエリ] WHERE " & strFilterterm
    Else
        MsgBox "検索条件を入力してください"
    End If

End Sub

これでstrClaimStとstrClaimEdとstrCompanyとstrInvoiceが他でも参照可能になりました。

プレビューボタンをクリックした時のプロシージャは以下の通りにしました。 コマンド48_Click←デフォルトで変えてません。。。

Private Sub コマンド48_Click()

    Dim strRequerySQL As String
    
    strRequerySQL = vbNullString
    
    If strInvoice <> "" Then
        strRequerySQL = strRequerySQL & " AND " & strInvoice
    End If
    
    If strClaimSt <> "" Then
        strRequerySQL = strRequerySQL & " AND ClaimDate>= " & "#" & strClaimSt & "#"
    End If
    
    If strClaimEd <> "" Then
        strRequerySQL = strRequerySQL & " AND ClaimDate<= " & "#" & strClaimEd & "#"
    End If
    
    If strCompany <> "" Then
        strRequerySQL = strRequerySQL & " AND CompanyName Like  '*" & strCompany & "*'"
    End If

    '不要な先頭の" AND "文字を取り除く
    strRequerySQL = Mid(strRequerySQL, 6)
            
    'プレビューする場合
    DoCmd.OpenReport "売上一覧クエリ", acViewPreview, , strRequerySQL

    '印刷する場合
    'DoCmd.OpenReport "売上一覧クエリ", , , strRequerySQL
       
End Sub

プレビューのままになっていますが、必要に応じてプレビューをコメントにして、印刷する場合のコードを有効にすれば印刷されると思います。(試してませんが。。。)

Share this article

facebook logohatena logotwitter logo

© Classmethod, Inc. All rights reserved.